1 Intro

Se presenta un analisis de la mortalidad por causas a nivel de departamentos que corresponden al nivel 3, o de Division Administrativa Menor (DAME). y se estima la pendiente.

1.1 Datos

data_mort <- readRDS("data_salidas/data_mortalidad_deptos.rds")
tabla_labels <- read.csv2("data_geo/lista_departamentos_codigos.csv")
glimpse(data_mort)
## Rows: 86,015
## Columns: 8
## $ gedad     <ord> e70_, e70_, e70_, e70_, e70_, e70_, e70_, e70_, e70_, e70_, …
## $ sexo      <dbl> 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, …
## $ geocodigo <chr> "14154", "42091", "78042", "42063", "14154", "6770", "10014"…
## $ label     <chr> "Sobremonte", "Limay Mahuida", "Magallanes", "Chical Co", "S…
## $ anio      <dbl> 2003, 2003, 2003, 2003, 2009, 2003, 2003, 2003, 2003, 2003, …
## $ grupo_oms <chr> "notrans", "notrans", "notrans", "notrans", "notrans", "notr…
## $ casos     <int> 75, 2, 71, 11, 63, 593, 28, 364, 92, 43, 60, 179, 177, 128, …
## $ pob       <dbl> 140, 4, 153, 27, 157, 1508, 73, 960, 245, 116, 165, 494, 490…
tabla_labels <- tabla_labels[,-1]
# mutate(
#     gedad = recode(
#       gedad,
#       "Menor de 24" = "e24_",
#       "25 a 69" = "e25_",
#       "70 y mas" = "e70_"
#     ),
#     sexo = recode(
#       sexo,
#       "Varón" = 1,
#       "Mujer" = 2
#     ),
#     grupo_oms = recode(
#       grupo_oms,
#       "Condiciones transmisibles, maternas, perinatales y nutricionales" = "trans",
#       "Enfermedades no transmisibles" = "notrans",
#       "Enfermedades mal definidas" = "maldef",
#       "Lesiones" = "lesi"
#     )

2 Estimacion pendiente

Para estimar la pendiente se requieren al menos 3 registros continuos para cada combinacion año-edad-grupo de causa.

var_agg <- c("anio", "geocodigo", "gedad", "grupo_oms")
data_mort |> 
  filter(!anio %in% c(2003, 2021)) |> 
  group_by_at(var_agg) |> 
  summarise(
    casos = sum(casos),
    pob = sum(pob),
    rmxm = casos / pob * 100000
  ) |> 
  ungroup()-> data_mort_gral
## `summarise()` has grouped output by 'anio', 'geocodigo', 'gedad'. You can
## override using the `.groups` argument.
glimpse(data_mort_gral)
## Rows: 30,720
## Columns: 7
## $ anio      <dbl> 2006, 2006, 2006, 2006, 2006, 2006, 2006, 2006, 2006, 2006, …
## $ geocodigo <chr> "10007", "10007", "10007", "10007", "10007", "10007", "10007…
## $ gedad     <ord> e24_, e24_, e24_, e24_, e25_, e25_, e25_, e25_, e70_, e70_, …
## $ grupo_oms <chr> "lesi", "maldef", "notrans", "trans", "lesi", "maldef", "not…
## $ casos     <int> 1, 1, 0, 3, 5, 2, 17, 2, 0, 3, 49, 5, 0, 0, 2, 0, 1, 3, 10, …
## $ pob       <dbl> 1950, 1950, 1950, 1950, 2127, 2127, 2127, 2127, 338, 338, 33…
## $ rmxm      <dbl> 51.28205, 51.28205, 0.00000, 153.84615, 235.07287, 94.02915,…
nested_data_mort <- data_mort_gral |> 
  nest(-geocodigo, -gedad, -grupo_oms)
## Warning: Supplying `...` without names was deprecated in tidyr 1.0.0.
## ℹ Please specify a name for each selection.
## ℹ Did you want `data = c(-geocodigo, -gedad, -grupo_oms)`?
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
nested_data_mort |> 
  mutate(
    mktest = purrr::map(data, ~ trend::mk.test(.x$rmxm)),
    tidied = purrr::map(mktest, broom::tidy)
  ) |> 
  unnest(tidied)
nested_data_mort[6141,]
## # A tibble: 1 × 4
##   geocodigo gedad grupo_oms data            
##   <chr>     <ord> <chr>     <list>          
## 1 94028     e70_  lesi      <tibble [5 × 4]>
nested_data_mort <- nested_data_mort[- 6141,]
nested_data_mort |> 
  mutate(
    mktest = purrr::map(data, ~ trend::mk.test(.x$rmxm)),
    tidied = purrr::map(mktest, broom::tidy)
  ) |> 
  unnest(tidied)
nested_data_mort <- nested_data_mort[- 6141,]
nested_data_mort |> 
  mutate(
    mktest = purrr::map(data, ~ trend::mk.test(.x$rmxm)),
    tidied = purrr::map(mktest, broom::tidy)
  ) |> 
  unnest(tidied)
nested_data_mort <- nested_data_mort[- 6141,]
nested_data_mort |> 
  mutate(
    mktest = purrr::map(data, ~ trend::mk.test(.x$rmxm)),
    tidied = purrr::map(mktest, broom::tidy)
  ) |> 
  unnest(tidied)
nested_data_mort <- nested_data_mort[- 6141,]
nested_data_mort |> 
  mutate(
    mktest = purrr::map(data, ~ trend::mk.test(.x$rmxm)),
    tidied = purrr::map(mktest, broom::tidy)
  ) |> 
  unnest(tidied) |> 
  select(geocodigo, gedad, grupo_oms, statistic, p.value) |> 
  filter(p.value<=0.1)-> mann_kendall_deptos
glimpse(mann_kendall_deptos)
## Rows: 1,182
## Columns: 5
## $ geocodigo <chr> "10007", "10007", "10007", "10014", "10021", "10035", "10035…
## $ gedad     <ord> e24_, e25_, e70_, e70_, e24_, e24_, e70_, e70_, e24_, e70_, …
## $ grupo_oms <chr> "lesi", "notrans", "trans", "notrans", "trans", "trans", "no…
## $ statistic <dbl> 2.204541, 2.204541, 2.204541, -1.714643, -2.204541, -1.71464…
## $ p.value   <dbl> 0.02748634, 0.02748634, 0.02748634, 0.08641073, 0.02748634, …
mann_kendall_deptos |> 
  mutate(
    pendiente = case_when(
      statistic == 0 ~ "mantuvo",
      statistic > 0 ~ "subio",
      statistic < 0 ~ "bajo"
      ),
    p.val= case_when(
      p.value <= .05 ~ "_alt.sig",
      p.value < .1 ~ "_sig",
      p.value > .1 ~ "_no.sig"
    ),
    mktest = paste(pendiente, p.val)
  ) |> 
  select(1:3, 8)->lista_pendientes
data_mort_gral |> 
  left_join(lista_pendientes, by=c("gedad", "grupo_oms", "geocodigo")) |> 
  mutate(
    mktest = if_else(
      is.na(mktest),
      "no.stat.sig",
      mktest
    )) |> 
  distinct(geocodigo, gedad, grupo_oms, mktest)-> data_mort_gral_pend

3 Analisis pendiente

data_mort_gral |> 
  left_join(lista_pendientes, by=c("gedad", "grupo_oms", "geocodigo")) |> 
  mutate(
    mktest = if_else(
      is.na(mktest),
      "no.stat.sig",
      mktest
    ))->data_mort_gral_mktest
data_mort_gral_mktest |> 
  filter(anio == 2018) |> 
  distinct(geocodigo, gedad, pob) |> 
  group_by(geocodigo) |> 
  summarise(
    pob = sum(pob)
  ) |> 
  mutate(
   pob_size = case_when(
      pob > 0 & pob < 5000 ~ "Menos de 5.000",
      pob >= 5001 & pob < 10000 ~ "de 5.000 a 10.000",
      pob >= 10001 & pob < 50000 ~ "de 10.000 a 50.000",
      pob >= 50001 & pob < 250000 ~ "de 50.000 a 250.000",
      pob >= 250001 & pob < 500000 ~ "de 250.000 a 500.000",
      pob >= 500001 ~ "de 500.000 y mas"
    ),
    pob_size = factor(pob_size, levels = c(
      "Menos de 5.000",
      "de 5.000 a 10.000",
      "de 10.000 a 50.000",
      "de 50.000 a 250.000",
      "de 250.000 a 500.000",
      "de 500.000 y mas"), ordered = TRUE)
  )->tabla_size_pob
# tasas relevantes

data_mort_gral_mktest |> 
  group_by_at(var_agg) |> 
  mutate(
    ici_rmxm = round(qchisq(0.025, 2 * casos) / (2 * pob) * 100000,1), #intervalo inferior
    ics_rmxm = round(qchisq(0.975, 2 * casos + 2) / (2 * pob) * 100000,1), # intervalo superior
    pob_size = tabla_size_pob$pob_size[match(geocodigo, tabla_size_pob$geocodigo)]
  ) |> 
  ungroup()->data_mort_gral_mktest
head(data_mort_gral_mktest)
## # A tibble: 6 × 11
##    anio geocodigo gedad grupo_oms casos   pob  rmxm mktest     ici_rmxm ics_rmxm
##   <dbl> <chr>     <ord> <chr>     <int> <dbl> <dbl> <chr>         <dbl>    <dbl>
## 1  2006 10007     e24_  lesi          1  1950  51.3 subio _al…      1.3     286.
## 2  2006 10007     e24_  maldef        1  1950  51.3 no.stat.s…      1.3     286.
## 3  2006 10007     e24_  notrans       0  1950   0   no.stat.s…      0       189.
## 4  2006 10007     e24_  trans         3  1950 154.  no.stat.s…     31.7     450.
## 5  2006 10007     e25_  lesi          5  2127 235.  no.stat.s…     76.3     549.
## 6  2006 10007     e25_  maldef        2  2127  94.0 no.stat.s…     11.4     340.
## # ℹ 1 more variable: pob_size <ord>
data_mort_gral_mktest |> 
  filter(mktest == "subio _alt.sig") |> 
  ggplot(aes(anio, rmxm, color=pob_size))+
  geom_jitter(alpha=.3)+
  stat_summary(fun.y=mean, geom = "smooth")+
  facet_wrap(~gedad+grupo_oms, scales="free_y")+
  theme(
    legend.position = "bottom",
    legend.text = element_text(size = 6),
    legend.key.size = unit(.5, "cm"),
    axis.text.x = element_text(size=8)
  )+
  guides(colour = guide_legend(ncol=6))+
  labs(
    color=""
  )
## Warning: The `fun.y` argument of `stat_summary()` is deprecated as of ggplot2 3.3.0.
## ℹ Please use the `fun` argument instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

plotly::ggplotly(
  
data_mort_gral_mktest |> 
  filter(gedad=="e70_", mktest=="subio _alt.sig", grupo_oms=="trans") |>
  mutate(label= tabla_labels$dame[match(geocodigo, tabla_labels$SearchGeoCode)]) |> 
  ggplot(aes(x=anio, label=label))+
  geom_line(aes(y=rmxm, colour = geocodigo))+
  geom_ribbon(aes(ymin = ici_rmxm, ymax = ics_rmxm, fill = geocodigo), alpha=.2)+
  facet_wrap(~pob_size)+
  theme(
    legend.position = "none",
    legend.key = element_blank()
        )+
  guides(
    color=guide_legend(label=FALSE),
    fill=guide_legend(label=FALSE)
    )
)

4 Geodata

Se importan los datos geograficos.

geo_depto <- read_sf("data_geo/departamentos.gpkg")
geo_prov <- read_sf("data_geo/provincias.gpkg")
data_mort_mktest_map <- data_mort_gral_pend |> 
  merge(geo_depto, by.x = "geocodigo", by.y = "DEPTO_LINK")
data_mort_mktest_map <- st_as_sf(data_mort_mktest_map)
geo_prov <- st_as_sf(geo_prov)
unique(data_mort_mktest_map$mktest)
## [1] "no.stat.sig"    "subio _alt.sig" "bajo _sig"      "bajo _alt.sig" 
## [5] "subio _sig"
ggplot()+
  geom_sf(data = data_mort_mktest_map, aes(fill=mktest), color=NA, lwd = 0)+
  scale_fill_manual(values =c("#218A86","#BECDAB","#F5F5F5", "#EEC392","#D06539"),
                    labels= c("bajo _alt.sig", "  bajo _sig  " ," no.stat.sig ", "  subio _sig ", "subio _alt.sig")
                    )+
  geom_sf(data = geo_prov, fill=NA, lwd=.1, color="gray9")+
  facet_grid(gedad~grupo_oms, switch = "y", labeller = label_wrap_gen(multi_line = TRUE))+
  theme_void()+
  theme(
    strip.text.x = element_text(size=6, colour = "grey40", margin = margin(r = .5, unit= "cm")),
    strip.text.y = element_text(angle = 0, size=6.5, colour = "grey40"),
    plot.title = element_text(hjust = .5, size = 10, color="grey30", face = "bold", margin = margin(t = .5, b = .01, unit = "cm")),
    plot.subtitle = element_text(hjust = 0.5, size=10,color="grey30", face = "bold", margin = margin(b = .5, unit = "cm")),
    legend.position = "bottom",
    legend.title.position = "top",
    legend.direction = "horizontal",
    legend.box.just = "center",
    legend.text.position = "bottom",
    legend.text = element_text(hjust = 1, size=6, colour = "grey40"),
    legend.key = element_rect(linewidth = .05),
    legend.key.size = unit(.4, "cm"),
    legend.key.spacing = unit(.05, "cm"),
    panel.spacing.x = unit(.5, "cm")
  )+
  labs(
    title = "Estimacion de pendiente evolucion mortalidad por causas (2005-2007 a 2017-2019)",
    subtitle = "segun grupos de edad y causa, provincias argentinas",
    fill = "Mann-Kendall test",
    caption = "Se estima de la pendiente +/- 0, p.value < 0.1 | p.value < 0.05"
  )->mapa1
mapa1

ggsave(plot= mapa1, "salida_graf/mann-kendal_deptos.png", dpi = "retina")
## Saving 7 x 5 in image